home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / tex / sortdemo.zip / LINEAR.PAS < prev    next >
Pascal/Delphi Source File  |  1987-09-03  |  2KB  |  100 lines
  1.                                             {  K.L. Noell, fhw 03.Sep.87 }
  2.  PROGRAM LinearSort_Demo (output);
  3.  CONST n=639;
  4.        range = 199;
  5.        clear_pixel = 0;
  6.        set_pixel =   3;
  7.  VAR
  8.        k: INTEGER;
  9.        num,loops,swaps,aloops,aswaps: REAL;
  10.        D: array [0..n] of INTEGER;
  11.  
  12.  PROCEDURE LinSort ;
  13.   { Sortieren des Feldes D }
  14.  
  15.  VAR   r,l : 0..n;
  16.        h : INTEGER;
  17.        finis : BOOLEAN;
  18.  
  19.  BEGIN
  20.     FOR r := 2 TO n DO BEGIN
  21.        finis := FALSE;
  22.        h := D[r];
  23.        l := r - 1;
  24.  
  25.        WHILE NOT finis AND (l>0) DO  BEGIN
  26.           loops := loops + 1;
  27.           IF h < D[l]
  28.              THEN BEGIN
  29.                   swaps := swaps + 1;
  30.                   Plot ((l+1),D[l+1],clear_pixel);
  31.                   D[l+1] := D[l];
  32.                   Plot ((l+1),D[l+1],set_pixel);
  33.                   l := l - 1;
  34.              END
  35.              ELSE finis := TRUE;
  36.        END;
  37.  
  38.        swaps := swaps + 1;
  39.        Plot ((l+1),D[l+1],clear_pixel);
  40.        D[l+1] := h;
  41.        Plot ((l+1),D[l+1],set_pixel);
  42.  
  43.     END;
  44.  END;  { Linsort }
  45.  
  46.  
  47.  BEGIN  (********  Mainprogram  LinearSort_Demo  ********************)
  48.  
  49.         HiRes;
  50.         HiResColor (Brown);
  51.         Palette (2);
  52.  
  53.         FOR k:=1 TO n DO BEGIN
  54.            num := 199*RANDOM;
  55.            D[k] := TRUNC (num);
  56.            Plot (k,D[k],set_pixel);
  57.         END;
  58.  
  59.        {Sorting start:}
  60.         loops := 0;
  61.         swaps := 0;
  62.         DELAY (1000);
  63.  
  64.         Linsort ;
  65.  
  66.         aloops := loops;
  67.         aswaps := swaps;
  68.         Writeln ('   Linear Sort a)  Loops,Swaps: ',loops,swaps);
  69.         Writeln;
  70.         Writeln ('b) Press any key to process with an array already sorted,');
  71.         Writeln ('   but in opposite direction.');
  72.  
  73.         REPEAT UNTIL KeyPressed;
  74.  
  75.         Hires;
  76.         GraphBackground(6);
  77.         Palette(2);
  78.  
  79.         FOR k:=1 TO n DO BEGIN
  80.            num := (n-k)/(n/range);
  81.            D[k] := TRUNC (num);
  82.            Plot (k,D[k],set_pixel);
  83.         END;
  84.  
  85.         loops := 0;
  86.         swaps := 0;
  87.         DELAY (1000);
  88.  
  89.         LinSort ;
  90.  
  91.         Writeln (' Linear Sort a)  Loops,Swaps: ',aloops,aswaps);
  92.         Writeln (' Linear Sort b)  Loops,Swaps: ',loops,swaps);
  93.         Writeln;
  94.         Writeln (' Press any key to exit.');
  95.  
  96.         REPEAT UNTIL KeyPressed;
  97.         TextMode;
  98.  
  99.  END.   (********  Mainprogram  LinearSort_Demo  ********************)
  100.